
# Source https://github.com/Leaflet/Leaflet.heat
heatmapDependency <- function() {
  list(
    htmltools::htmlDependency(
      "Leaflet.heat",version = "0.1.0",
      system.file("htmlwidgets/lib/heat", package = "leaflet.extras"),
      script = c("leaflet-heat.js", "heat-bindings.js")
    )
  )
}

#' Add a heatmap
#' @param map the map widget.
#' @param lng a numeric vector of longitudes, or a one-sided formula of the form
#'   \code{~x} where \code{x} is a variable in \code{data}; by default (if not
#'   explicitly provided), it will be automatically inferred from \code{data} by
#'   looking for a column named \code{lng}, \code{long}, or \code{longitude}
#'   (case-insensitively)
#' @param lat a vector of latitudes or a formula (similar to the \code{lng}
#'   argument; the names \code{lat} and \code{latitude} are used when guessing
#'   the latitude column from \code{data})
#' @param intensity intensity of the heat. A vector of numeric values or a formula.
#' @param minOpacity minimum opacity at which the heat will start
#' @param max  maximum point intensity. The default is \code{1.0}
#' @param radius radius of each "point" of the heatmap.  The default is
#'          \code{25}.
#' @param blur amount of blur to apply.  The default is \code{15}.
#'          \code{blur=1} means no blur.
#' @param gradient palette name from \code{RColorBrewer} or an array of
#'          of colors to be provided to \code{\link{colorNumeric}}, or
#'          a color mapping function returned from \code{colorNumeric}
#' @param cellSize  the cell size in the grid. Points which are closer
#'          than this may be merged. Defaults to `radius / 2`.s
#'          Set to `1` to do almost no merging.
#' @param layerId the layer id
#' @param group the name of the group the newly created layers should belong to
#'   (for \code{\link{clearGroup}} and \code{\link{addLayersControl}} purposes).
#'   Human-friendly group names are permitted--they need not be short,
#'   identifier-style names. Any number of layers and even different types of
#'   layers (e.g. markers and polygons) can share the same group name.
#' @param data the data object from which the argument values are derived; by
#'   default, it is the \code{data} object provided to \code{leaflet()}
#'   initially, but can be overridden
#' @rdname heatmap
#' @export
addHeatmap = function(
  map, lng = NULL, lat = NULL, intensity = NULL, layerId = NULL, group = NULL,
  minOpacity = 0.05,
  max = 1.0, radius = 25,
  blur = 15, gradient = NULL, cellSize = NULL,
  data = leaflet::getMapData(map)
) {
  map$dependencies <- c(map$dependencies,
                        heatmapDependency())
  
  #convert gradient to expected format from leaflet
  if (!is.null(gradient) && !is.function(gradient)) {
      gradient <- colorNumeric( gradient, 0:1 )
      gradient <- as.list(gradient(0:20 / 20))
      names(gradient) <- as.character(0:20 / 20)
  }

  pts = leaflet::derivePoints(
    data, lng, lat, missing(lng), missing(lat), "addHeatmap")

  if(is.null(intensity)) {
    points <- cbind(pts$lat, pts$lng)
  } else {
    if(inherits(intensity,'formula')) {
      intensity <- eval(intensity[[2]], data, environment(intensity))
    }
    points <- cbind(pts$lat, pts$lng, intensity)
  }

  leaflet::invokeMethod(
    map, data, 'addHeatmap', points,
    layerId, group,
    leaflet::filterNULL(list(
      minOpacity = minOpacity,
      max = max,
      radius = radius,
      blur = blur,
      gradient = gradient,
      cellSize = cellSize
    ))
  ) %>% leaflet::expandLimits(pts$lat, pts$lng)
}

#' Adds a heatmap with data from a GeoJSON/TopoJSON file/url
#' @param geojson The geojson or topojson url or contents as string.
#' @param intensityProperty The property to use for determining the intensity at a point.
#' Can be a 'string' or a JS function, or NULL.
#' @rdname heatmap
#' @export
addGeoJSONHeatmap = function(
  map, geojson, layerId = NULL, group = NULL,
  intensityProperty = NULL,
  minOpacity = 0.05,
  max = 1.0, radius = 25,
  blur = 15, gradient = NULL, cellSize = NULL
  ) {
  map$dependencies <- c(map$dependencies, omnivoreDependencies())
  map$dependencies <- c(map$dependencies, heatmapDependency())

  leaflet::invokeMethod(
    map, leaflet::getMapData(map),
    'addGeoJSONHeatmap', geojson, intensityProperty,
    layerId, group,
    leaflet::filterNULL(list(
      minOpacity = minOpacity,
      max = max,
      radius = radius,
      blur = blur,
      gradient = gradient,
      cellSize = cellSize
    )))
}

#' Adds a heatmap with data from a KML file/url
#' @param kml The KML url or contents as string.
#' @rdname heatmap
#' @export
addKMLHeatmap = function(
  map, kml, layerId = NULL, group = NULL,
  intensityProperty = NULL,
  minOpacity = 0.05,
  max = 1.0, radius = 25,
  blur = 15, gradient = NULL, cellSize = NULL
  ) {
  map$dependencies <- c(map$dependencies, omnivoreDependencies())
  map$dependencies <- c(map$dependencies, heatmapDependency())

  leaflet::invokeMethod(
    map, leaflet::getMapData(map),
    'addKMLHeatmap', kml, intensityProperty,
    layerId, group,
    leaflet::filterNULL(list(
      minOpacity = minOpacity,
      max = max,
      radius = radius,
      blur = blur,
      gradient = gradient,
      cellSize = cellSize
    )))
}

#' Adds a heatmap with data from a CSV file/url
#' @param csv The CSV url or contents as string.
#' @param csvParserOptions options for parsing the CSV.
#' Use \code{\link{csvParserOptions}}() to supply csv parser options.
#' @rdname heatmap
#' @export
addCSVHeatmap = function(
  map, csv, csvParserOptions, layerId = NULL, group = NULL,
  intensityProperty = NULL,
  minOpacity = 0.05,
  max = 1.0, radius = 25,
  blur = 15, gradient = NULL, cellSize = NULL
  ) {
  map$dependencies <- c(map$dependencies, omnivoreDependencies())
  map$dependencies <- c(map$dependencies, heatmapDependency())

  leaflet::invokeMethod(
    map, leaflet::getMapData(map),
    'addCSVHeatmap', csv, intensityProperty,
    layerId, group,
    leaflet::filterNULL(list(
      minOpacity = minOpacity,
      max = max,
      radius = radius,
      blur = blur,
      gradient = gradient,
      cellSize = cellSize
    )),
    csvParserOptions)
}

#' Adds a heatmap with data from a GPX file/url
#' @param gpx The GPX url or contents as string.
#' @rdname heatmap
#' @export
addGPXHeatmap = function(
  map, gpx, layerId = NULL, group = NULL,
  intensityProperty = NULL,
  minOpacity = 0.05,
  max = 1.0, radius = 25,
  blur = 15, gradient = NULL, cellSize = NULL
  ) {
  map$dependencies <- c(map$dependencies, omnivoreDependencies())
  map$dependencies <- c(map$dependencies, heatmapDependency())

  leaflet::invokeMethod(
    map, leaflet::getMapData(map),
    'addGPXHeatmap', gpx, intensityProperty,
    layerId, group,
    leaflet::filterNULL(list(
      minOpacity = minOpacity,
      max = max,
      radius = radius,
      blur = blur,
      gradient = gradient,
      cellSize = cellSize
    )))
}


#' removes the heatmap
#' @rdname heatmap
#' @export
removeHeatmap = function(map, layerId) {
    leaflet::invokeMethod(map, leaflet::getMapData(map), 'removeHeatmap', layerId)
}

#' clears the heatmap
#' @rdname heatmap
#' @export
clearHeatmap = function(map) {
    leaflet::invokeMethod(map, NULL, 'clearHeatmap')
}
